(* -*- sml -*- *)
(**
 * @copyright (C) 2021 SML# Development Team.
 * @author UENO Katsuhiro
 *)
structure LLVMIR =
struct

  fun ifcons (x,y) (_::_) = x
    | ifcons (x,y) nil = y
  fun ifsome (x,y) (SOME _) = x
    | ifsome (x,y) NONE = y
  fun iftrue (x,y) true = x
    | iftrue (x,y) false = y
  fun ifempty (x,y) "" = x
    | ifempty (x,y) _ = y
  fun term s = [SMLFormat.FormatExpression.Term (size s, s)]

  type loc = Loc.loc

  (*% @formatter(FunLocalLabel.id) FunLocalLabel.format_id *)
  type label =
       (*% @format(id) id *)
       FunLocalLabel.id

  (*% @formatter(HandlerLabel.id) HandlerLabel.format_id *)
  type landingPadLabel =
       (*% @format(id) "H" id *)
       HandlerLabel.id

  (*% @formatter(VarID.id) VarID.format_id *)
  type var =
       (*% @format(id) "%v" id *)
       VarID.id

  (*% *)
  type symbol =
       (*% @format(x) "@" x *)
       string

  (*% *)
  datatype calling_convention =
      (*% @format "ccc" *)
      CCC
    | (*% @format "fastcc" *)
      FASTCC
    | (*% @format "coldcc" *)
      COLDCC
    | (*% @format "x86_stdcallcc" *)
      X86STDCALLCC
(*
    | (*% @format(n) "cc" + n *)
      CC of int
*)

  (*% *)
  datatype linkage =
      (*% @format "internal" *)
      INTERNAL
    | (*% @format "private" *)
      PRIVATE
    | (*% @format "external" *)
      EXTERNAL
    | (*% @format "appending" *)
      APPENDING
    | (*% @format "linkonce" *)
      LINKONCE
    | (*% @format "weak" *)
      WEAK
    | (*% @format "linkonce_odr" *)
      LINKONCE_ODR
    | (*% @format "weak_odr" *)
      WEAK_ODR

  (*% *)
  datatype tail =
      (*% @format "tail" *)
      TAIL
    | (*% @format "musttail" *)
      MUSTTAIL

  (*% *)
  datatype parameter_attribute =
      (*% @format "zeroext" *)
      ZEROEXT
    | (*% @format "signext" *)
      SIGNEXT
    | (*% @format "inreg" *)
      INREG
    | (*% @format "byval" *)
      BYVAL
    | (*% @format "sret" *)
      SRET
    | (*% @format "noalias" *)
      NOALIAS
    | (*% @format "nocapture" *)
      NOCAPTURE
    | (*% @format "nest" *)
      NEST

  (*% *)
  datatype function_attribute =
(*
      (*% @format(n) "alignstack(" n ")" *)
      ALIGNSTACK of int
    |
*)
      (*% @format "alwaysinline" *)
      ALWAYSINLINE
(*
    | (*% @format "cold" *)
      COLD
*)
    | (*% @format "nonlazybind" *)
      NONLAZYBIND
    | (*% @format "inlinehint" *)
      INLINEHINT
    | (*% @format "naked" *)
      NAKED
(*
    | (*% @format "nobuiltin" *)
      NOBUILTIN
    | (*% @format "noduplicate" *)
      NODUPLICATE
*)
    | (*% @format "noimplicitfloat" *)
      NOIMPLICITFLOAT
    | (*% @format "noinline" *)
      NOINLINE
    | (*% @format "noredzone" *)
      NOREDZONE
    | (*% @format "noreturn" *)
      NORETURN
    | (*% @format "nounwind" *)
      NOUNWIND
    | (*% @format "optsize" *)
      OPTSIZE
    | (*% @format "readnone" *)
      READNONE
    | (*% @format "readonly" *)
      READONLY
    | (*% @format "returns_twice" *)
      RETURNS_TWICE
(*
    | (*% @format "sanitize_address" *)
      SANITIZE_ADDRESS
    | (*% @format "sanitize_memory" *)
      SANITIZE_MEMORY
    | (*% @format "sanitize_thread" *)
      SANITIZE_THREAD
*)
    | (*% @format "ssp" *)
      SSP
    | (*% @format "sspreq" *)
      SSPREQ
(*
    | (*% @format "sspstrong" *)
      SSPSTRONG
*)
    | (*% @format "uwtable" *)
      UWTABLE

  fun word32Dec x =
      term (Word32.fmt StringCvt.DEC x)
  fun word64Dec x =
      term (Word64.fmt StringCvt.DEC x)
  fun hex8 x =
      term (StringCvt.padLeft #"0" 8 (Word32.fmt StringCvt.HEX x))
  fun realExact x =
      term (CharVector.map (fn #"~" => #"-" | c => c)
                           (Real.fmt StringCvt.EXACT x))

  (*% *)
  datatype noWrap =
      (*% @format *)
      WRAP
    | (*% @format " nuw" *)
      NUW
    | (*% @format " nsw" *)
      NSW
(*
    | (*% @format "nuw nsw" *)
      NUW_NSW
*)

  (*%
   * @formatter(Word32.word) word32Dec
   * @formatter(ifcons) ifcons
   * @formatter(iftrue) iftrue
   *)
  datatype ty =
      (*% @format "i1" *)
      I1
    | (*% @format "i8" *)
      I8
    | (*% @format "i16" *)
      I16
    | (*% @format "i32" *)
      I32
    | (*% @format "i64" *)
      I64
    | (*% @format(ty) ty "*" *)
      PTR of ty 
    | (*% @format "float" *)
      FLOAT
    | (*% @format "double" *)
      DOUBLE
    | (*% @format "void" *)
      VOID
    | (*%
       * @format(retTy * argTy argTys * vararg)
       * retTy
       * "("
       * argTys(argTy)(",")
       * vararg:iftrue()(argTys:ifcons()(",",) "...",)
       * ")"
       *)
      FN of ty * ty list * bool
    | (*% @format(len * ty) "[" len " x " ty "]" *)
      ARRAY of Word32.word * ty
    | (*% @format(ty tys * {packed})
       * packed:iftrue()("<{","{")
       * tys(ty)(",")
       * packed:iftrue()("}>","}")
       *)
      STRUCT of ty list * {packed: bool}

  (*%
   * @formatter(Word64.word) word64Dec
   * @formatter(real) realExact
   * @formatter(iftrue) iftrue
   * @formatter(ifcons) ifcons
   *)
  datatype const =
      (*% @format(w) w *)
      INTCONST of Word64.word
    | (*% @format(r) r *)
      FLOATCONST of real
    | (*% @format "null" *)
      NULL
    | (*% @format "undef" *)
      UNDEF
    | (*% @format(s) s *)
      SYMBOL of symbol
    | (*% @format((ty1 * c) * ty2) "bitcast (" ty1 " " c " to " ty2 ")" *)
      CONST_BITCAST of (ty * const) * ty
    | (*% @format((ty1 * c) * ty2) "inttoptr (" ty1 " " c " to " ty2 ")" *)
      CONST_INTTOPTR of (ty * const) * ty
    | (*% @format((ty1 * c) * ty2) "ptrtoint (" ty1 " " c " to " ty2 ")" *)
      CONST_PTRTOINT of (ty * const) * ty
    | (*% @format(w * (ty1 * c1) * (ty2 * c2))
       *  "sub" w " (" ty1 " " c1 ", " ty2 " " c2" )" *)
      CONST_SUB of noWrap * (ty * const) * (ty * const)
    | (*%
       * @format({inbounds, ty, ptr, indices: index indices})
       * "getelementptr "
       * inbounds:iftrue()("inbounds ",)
       * "("
       * ty ", "
       * ptr
       * indices:ifcons()(", ",)
       * indices(index)(", ")
       * ")"
       * @format:ptr(ty * c)
       * ty " " c
       * @format:index(ty * c)
       * ty " " c
       *)
      CONST_GETELEMENTPTR of
      {
        inbounds : bool,
        ty : ty,
        ptr : ty * const,
        indices : (ty * const) list
      }

  (*% *)
  datatype value =
      (*% @format(c) c *)
      CONST of const
    | (*% @format(v) v *)
      VAR of var

  (*% *)
  (*% @prefix formatValue_
   * @formatter(value) format_value
   *)
  (*% @prefix formatTy_
   * @formatter(ty) format_ty
   *)
  type operand =
      (*% @format(ty * v) ty " " v *)
      (*% @prefix formatValue_ @format(ty * v) v *)
      (*% @prefix formatTy_ @format(ty * v) ty *)
       ty * value

  fun formatRetTy_operand ((ty, _):operand) =
      case ty of
        PTR (FN (ty, _, false)) => format_ty ty
      | PTR (ty as FN (_, _, true)) => format_ty ty
      | _ => format_ty ty

  (*% *)
  datatype icmp =
      (*% @format "eq" *)
      EQ
    | (*% @format "ne" *)
      NE
    | (*% @format "ugt" *)
      UGT
    | (*% @format "uge" *)
      UGE
    | (*% @format "ult" *)
      ULT
    | (*% @format "ule" *)
      ULE
    | (*% @format "sgt" *)
      SGT
    | (*% @format "sge" *)
      SGE
    | (*% @format "slt" *)
      SLT
    | (*% @format "sle" *)
      SLE

  (*% *)
  datatype fcmp =
      (*% @format "false" *)
      F_FALSE
    | (*% @format "oeq" *)
      F_OEQ
    | (*% @format "ogt" *)
      F_OGT
    | (*% @format "oge" *)
      F_OGE
    | (*% @format "olt" *)
      F_OLT
    | (*% @format "ole" *)
      F_OLE
    | (*% @format "one" *)
      F_ONE
    | (*% @format "ord" *)
      F_ORD
    | (*% @format "ueq" *)
      F_UEQ
    | (*% @format "ugt" *)
      F_UGT
    | (*% @format "uge" *)
      F_UGE
    | (*% @format "ult" *)
      F_ULT
    | (*% @format "ule" *)
      F_ULE
    | (*% @format "une" *)
      F_UNE
    | (*% @format "uno" *)
      F_UNO
    | (*% @format "true" *)
      F_TRUE

(*
  (*% *)
  datatype fastMathFlag =
      (*% @format *)
      PIYO
*)

(*
  (*% @formatter(bool) SmlppgUtil.formatBinaryChoice *)
  type exact =
      (*% @format(x) x()("exact ",) *)
      bool
*)

  (*% *)
  datatype op2 =
      (*% @format "or" *)
      OR
    | (*% @format(w) "add" w *)
      ADD of noWrap
    | (*% @format "fadd" *)
      FADD (*of fastMathFlag list*)
    | (*% @format(w) "sub" w *)
      SUB of noWrap
    | (*% @format "fsub" *)
      FSUB (*of fastMathFlag list*)
    | (*% @format(w) "mul" w *)
      MUL of noWrap
    | (*% @format "fmul" *)
      FMUL (*of fastMathFlag list*)
    | (*% @format "udiv" *)
      UDIV (*of exact*)
    | (*% @format "sdiv" *)
      SDIV (*of exact*)
    | (*% @format "fdiv" *)
      FDIV (*of fastMathFlag list*)
    | (*% @format "urem" *)
      UREM
    | (*% @format "srem" *)
      SREM
    | (*% @format "frem" *)
      FREM (*of fastMathFlag list*)
    | (*% @format "shl" *)
      SHL (*of noWrap*)
    | (*% @format "lshr" *)
      LSHR (*of exact*)
    | (*% @format "ashr" *)
      ASHR (*of exact*)
    | (*% @format "and" *)
      AND
    | (*% @format "xor" *)
      XOR

  (*% *)
  datatype conv =
      (*% @format "bitcast" *)
      BITCAST
    | (*% @format "trunc" *)
      TRUNC
    | (*% @format "sitofp" *)
      SITOFP
    | (*% @format "fptosi" *)
      FPTOSI
    | (*% @format "fptoui" *)
      FPTOUI
    | (*% @format "fptrunc" *)
      FPTRUNC
    | (*% @format "fpext" *)
      FPEXT
    | (*% @format "zext" *)
      ZEXT
    | (*% @format "sext" *)
      SEXT
    | (*% @format "inttoptr" *)
      INTTOPTR
    | (*% @format "ptrtoint" *)
      PTRTOINT

  (*% *)
  datatype atomic_ordering =
      (*% @format "unordered" *)
      UNORDERED
    | (*% @format "monotonic" *)
      MONOTONIC
    | (*% @format "acquire" *)
      ACQUIRE
    | (*% @format "release" *)
      RELEASE
    | (*% @format "acq_rel" *)
      ACQ_REL
    | (*% @format "seq_cst" *)
      SEQ_CST

  (*%
   * @formatter(valueOf) formatValue_operand
   * @formatter(tyOf) formatTy_operand
   * @formatter(retTyOf) formatRetTy_operand
   * @formatter(iftrue) iftrue
   * @formatter(ifcons) ifcons
   * @formatter(ifsome) ifsome
   * @formatter(word) word32Dec
   *)
  datatype insn =
      (*% @format(v * ty * x) v " = load " ty ", " x *)
      LOAD of var * ty * operand
(*
              {volatile: bool,
               align: int option, 
               nontemporal: index option,
               invaliantLoad: index option}
*)
    | (*% @format(v * ty * x * {order, align})
       * v " = load atomic " ty ", " x " " order ", align " align *)
      LOAD_ATOMIC of var * ty * operand * {order: atomic_ordering, align: word}
    | (*% @format({value, dst}) "store " value ", " dst *)
      STORE of {value: operand, dst: operand}
(*
 align: int option,
 nontemporal: index option}
*)
    | (*% @format({value, dst, order, align})
       * "store " value " " order ", " dst ", align " align *)
      STORE_ATOMIC of {value: operand, dst: operand, order: atomic_ordering,
                       align: word}
    | (*% @format(v * ty * opt optOpt)
       * v " = alloca " ty
       * optOpt:ifsome()(", " optOpt(opt),)
       * @format:opt({align})
       * "align " align
       *)
      ALLOCA of var * ty * {align: word} option
(** {numElements : (ty * value) option, align : int option}*)
    | (*%
       * @format({result: result resultOpt,
       *          tail: tail tailOpt,
       *          cconv: cconv cconvOpt,
       *          retAttrs: retAttr retAttrs,
       *          fnPtr,
       *          args: arg args,
       *          fnAttrs: fnAttr fnAttrs})
       * resultOpt(result)
       * resultOpt:ifsome()(" = ",)
       * tailOpt(tail)
       * tailOpt:ifsome()(" ",)
       * "call "
       * cconvOpt(cconv)
       * cconvOpt:ifsome()(" ",)
       * retAttrs(retAttr)(" ")
       * retAttrs:ifcons()(" ",)
       * fnPtr:retTyOf
       * " "
       * fnPtr:valueOf
       * "("
       * args(arg)(", ")
       * ")"
       * fnAttrs:ifcons()(" ",)
       * fnAttrs(fnAttr)(" ")
       * @format:arg(attr attrs * arg)
       * arg:tyOf
       * " "
       * attrs(attr)(" ")
       * attrs:ifcons()(" ",)
       * arg:valueOf
       *)
      CALL of 
      {
        result: var option,
        tail: tail option,
        cconv: calling_convention option,
        retAttrs: parameter_attribute list,
        fnPtr: operand,
        args: (parameter_attribute list * operand) list,
        fnAttrs: function_attribute list
      }
    | (*%
       * @format({result, inbounds, ty, ptr, indices: index indices})
       * result " = getelementptr "
       * inbounds:iftrue()("inbounds ",)
       * ty ", "
       * ptr
       * indices:ifcons()(", ",)
       * indices(index)(", ")
       *)
      GETELEMENTPTR of
      {
        result: var,
        ty: ty,
        inbounds: bool,
        ptr: operand,
        indices: operand list
      }
    | (*% @format(v * op1 * i) v " = extractvalue " op1 ", " i *)
      EXTRACTVALUE of var * operand * int
    | (*% @format(v * op1 * op2 * i) v " = insertvalue " op1 ", " op2 ", " i *)
      INSERTVALUE of var * operand * operand * int
    | (*% @format(v * conv * x * ty) v " = " conv " " x " to " ty *)
      CONV of var * conv * operand * ty
    | (*% @format(v * op2 * x * y) v " = " op2 " " x ", " y:valueOf *)
      OP2 of var * op2 * operand * operand
    | (*% @format(v * cmp * x * y) v " = icmp " cmp " " x ", " y:valueOf *)
      ICMP of var * icmp * operand * operand
    | (*% @format(v * cmp * x * y) v " = fcmp " cmp " " x ", " y:valueOf *)
      FCMP of var * fcmp * operand * operand
    | (*% @format(v * b * x * y) v " = select " b ", " x ", " y *)
      SELECT of var * operand * operand * operand

  (*% *)
  (*% @prefix formatArg_
   * @formatter(label) format_label
   * @formatter(operand) formatValue_operand
   * @formatter(ifcons) ifcons
   *)
  type destination =
      (*% @format(l * p ps) "label %" l *)
      (*% @prefix formatArg_
       * @format(l * phi phis)
       * phis:ifcons()("\n ; (phi) " l ": " phis(phi)(", "),)
       *)
      label * operand list

  (*% *)
  datatype phi_label =
      (*% @format(l) "%" l *)
      BLOCKLABEL of label
    | (*% @format(l) "%" l *)
      LPADLABEL of landingPadLabel
    | (*% @format(l) "%0" *)
      BEGINFUNC

  (*%
   * @formatter(ifcons) ifcons
   * @formatter(ifsome) ifsome
   *)
  datatype phi =
      (*%
       * @format(ty * var)
       * "; " var " = phi " ty
       *)
      PHI of ty * var
    | (*%
       * @format(var * ty * arg args)
       * args:ifcons()(
       *   var " = phi " ty " " args(arg)(", "),
       *   var " = bitcast " ty " undef to " ty
       * )
       * @format:arg(v * l)
       * "[" v ", " l "]"
       *)
      PHI_COMPLETE of var * ty * (value * phi_label) list

  (*%
   * @formatter(valueOf) formatValue_operand
   * @formatter(retTyOf) formatRetTy_operand
   * @formatter(tyOf) formatTy_operand
   * @formatter(argOf) formatArg_destination
   * @formatter(iftrue) iftrue
   * @formatter(ifcons) ifcons
   * @formatter(ifsome) ifsome
   *)
  datatype last =
      (*%
       * @format({label, phis: phi phis, body, next})
       * "; available " label \n
       * next \n
       * label ":" \n
       * phis(phi)(\n)
       * phis:ifcons()(\n,)
       * body
       *)
      BLOCK of
      {
        label: label,
        phis: phi list,
        body: body,
        next: body
      }
    | (*%
       * @format({label, argVar: arg * argTy,
       *          catch: catch catches, cleanup, body, next})
       * "; available " label \n
       * next \n
       * label ":" \n
       * arg " = landingpad " argTy
       * cleanup:iftrue()(" cleanup",)
       * catches:ifcons()(" catch ",)
       * catches(catch)(" catch ") \n
       * body
       *)
      LANDINGPAD of
      {
        label: landingPadLabel,
        argVar : var * ty,
        catch : operand list,
        cleanup : bool,
        body: body,
        next: body
      }
    | (*% @format(x) "ret " x *)
      RET of operand
    | (*% @format(x) "ret void" *)
      RET_VOID
    | (*%
       * @format(l)
       * "br " l 
       * l:argOf
       *)
      BR of destination
    | (*%
       * @format(x * l1 * l2)
       * "br " x ", " l1 ", " l2
       * l1:argOf
       * l2:argOf
       *)
      BR_C of operand * destination * destination
    | (*%
       * @format({result: result resultOpt,
       *          cconv: cconv cconvOpt,
       *          retAttrs: retAttr retAttrs,
       *          fnPtr,
       *          args: arg args,
       *          fnAttrs: fnAttr fnAttrs,
       *          to,
       *          unwind})
       * resultOpt(result)
       * resultOpt:ifsome()(" = ",)
       * "invoke "
       * cconvOpt(cconv)
       * cconvOpt:ifsome()(" ",)
       * retAttrs(retAttr)(" ")
       * retAttrs:ifcons()(" ",)
       * fnPtr:retTyOf
       * " "
       * fnPtr:valueOf
       * "("
       * args(arg)(", ")
       * ")"
       * fnAttrs:ifcons()(" ",)
       * fnAttrs(fnAttr)(" ")
       * " to label %" to
       * " unwind label %" unwind
       * resultOpt:ifsome()(\n "; (phi) " to ": " resultOpt(result),)
       * @format:arg(attr attrs * arg)
       * arg:tyOf
       * " "
       * attrs(attr)(" ")
       * attrs:ifcons()(" ",)
       * arg:valueOf
       *)
      INVOKE of 
      {
        result: var option,
        cconv: calling_convention option,
        retAttrs: parameter_attribute list,
        fnPtr: operand,
        args: (parameter_attribute list * operand) list,
        fnAttrs: function_attribute list,
        to: label,
        unwind: landingPadLabel
      }
    | (*% @format(x) "resume " x *)
      RESUME of operand
    | (*%
       * @format({value, default, branches: branch branches})
       * "switch " value ", " default " ["
       * 1[
       *  branches:ifcons()(\n,)
       *  branches(branch)(\n)
       * ]
       * \n "]"
       * default:argOf
       * @format:branch((ty * const) * label)
       * ty " " const ", " label
       * label:argOf
       *)
      SWITCH of
      {value: operand,
       default: destination,
       branches: ((ty * const) * destination) list}
    | (*% @format "unreachable" *)
      UNREACHABLE

  withtype body =
      (*%
       * @format(insn insns * last)
       * insns(insn)(\n)
       * insns:ifcons()(\n,)
       * last
       *)
      insn list * last

  fun formatString s = term ("\"" ^ s ^ "\"")

  fun formatStringLiteral s =
      formatString
        (String.translate
           (fn c =>
               if Char.isAlphaNum c orelse c = #" " then str c
               else "\\" ^ StringCvt.padLeft #"0" 2
                                             (Int.fmt StringCvt.HEX (ord c)))
           s)

  (*%
   * @formatter(iftrue) iftrue
   * @formatter(string) formatStringLiteral
   *)
  datatype initializer =
      (*% @format "zeroinitializer" *)
      ZEROINITIALIZER
    | (*% @format(x) "c" x *)
      INIT_STRING of string
    | (*% @format(c) c *)
      INIT_CONST of const
    | (*%
       * @format(field fields * {packed})
       * packed:iftrue()("<{","{")
       * fields(field)(", ")
       * packed:iftrue()("}>","}")
       * @format:field(ty * init)
       * ty " " init
       *)
      INIT_STRUCT of (ty * initializer) list * {packed: bool}
    | (*%
       * @format(field fields)
       * "[" fields(field)(", ") "]"
       * @format:field(ty * init)
       * ty " " init
       *)
      INIT_ARRAY of (ty * initializer) list

  (*%
   * @formatter(string) formatString
   * @formatter(iftrue) iftrue
   * @formatter(ifsome) ifsome
   * @formatter(ifcons) ifcons
   *)
  datatype topdec =
      (*%
       * @format({linkage: linkage linkageOpt,
       *          cconv: cconv cconvOpt,
       *          retAttrs: retAttr retAttrs,
       *          retTy,
       *          name,
       *          parameters: arg args,
       *          fnAttrs: fnAttr fnAttrs,
       *          personality: personality personalityOpt,
       *          gcname: gcname gcnameOpt,
       *          body})
       * "define "
       * linkageOpt(linkage)
       * linkageOpt:ifsome()(" ",)
       * cconvOpt(cconv)
       * cconvOpt:ifsome()(" ",)
       * retAttrs(retAttr)(" ")
       * retAttrs:ifcons()(" ",)
       * retTy " "
       * name
       * "("
       * args(arg)(", ")
       * ")"
       * fnAttrs:ifcons()(" ",)
       * fnAttrs(fnAttr)(" ")
       * gcnameOpt:ifsome()(" gc ",)
       * gcnameOpt(gcname)
       * personalityOpt:ifsome()(" personality ",)
       * personalityOpt(personality)
       * "{"
       * 1[ \n body ]
       * \n "}"
       * @format:arg(ty * attr attrs * v)
       * ty " "
       * attrs(attr)(" ")
       * attrs:ifcons()(" ",)
       * v
       * @format:personality(ty * c)
       * ty " " c
       *)
      DEFINE of
      {
        linkage : linkage option,
(*
        visibility : visibility option,
*)
        cconv : calling_convention option,
        retAttrs : parameter_attribute list,
        retTy : ty,
        name : symbol,
        parameters : (ty * parameter_attribute list * var) list,
        fnAttrs : function_attribute list,
        personality : (ty * const) option,
(*
        section : string option,
        align : int option,
*)
        gcname : string option,
        body : body
      }
    | (*%
       * @format({linkage: linkage linkageOpt,
       *          cconv: cconv cconvOpt,
       *          retAttrs: retAttr retAttrs,
       *          retTy,
       *          name,
       *          arguments: arg args,
       *          varArg,
       *          fnAttrs: fnAttr fnAttrs,
       *          gcname: gcname gcnameOpt})
       * "declare "
       * linkageOpt(linkage)
       * linkageOpt:ifsome()(" ",)
       * cconvOpt(cconv)
       * cconvOpt:ifsome()(" ",)
       * retAttrs(retAttr)(" ")
       * retAttrs:ifcons()(" ",)
       * retTy " "
       * name
       * "("
       * args(arg)(", ")
       * varArg:iftrue()(args:ifcons()(",",) "...",)
       * ")"
       * fnAttrs:ifcons()(" ",)
       * fnAttrs(fnAttr)(" ")
       * gcnameOpt:ifsome()(" gc ",)
       * gcnameOpt(gcname)
       * @format:arg(ty * attr attrs)
       * ty
       * attrs:ifcons()(" ",)
       * attrs(attr)(" ")
       *)
      DECLARE of
      {
        linkage : linkage option,
(*
        visibility : visibility option,
*)
        cconv : calling_convention option,
(*
        unnamed_addr : bool,
*)
        retAttrs : parameter_attribute list,
        retTy : ty,
        name : symbol,
        arguments : (ty * parameter_attribute list) list,
        varArg : bool,
        fnAttrs : function_attribute list,
        gcname : string option
      }
    | (*%
       * @format({name,
       *          linkage: linkage linkageOpt,
       *          unnamed_addr,
       *          constant,
       *          ty,
       *          initializer,
       *          align: align alignOpt})
       * name " = "
       * linkageOpt(linkage)
       * linkageOpt:ifsome()(" ",)
       * unnamed_addr:iftrue()("unnamed_addr ",)
       * constant:iftrue()("constant ","global ")
       * ty " "
       * initializer
       * alignOpt:ifsome()(", align ",)
       * alignOpt(align)
       *)
      GLOBALVAR of
      {
        name : symbol,
(*
        thread_local : tls_model option,
        addrspace : int option,
*)
        linkage : linkage option,
        unnamed_addr : bool,
        constant : bool,
        ty : ty,
        initializer : initializer,
(*
        section : string option,
*)
        align : int option
      }
    | (*%
       * @format({name, ty, linkage: linkage linkageOpt, unnamed_addr, aliasee})
       * name " = "
       * linkageOpt(linkage)
       * linkageOpt:ifsome()(" ",)
       * unnamed_addr:iftrue()("unnamed_addr ",)
       * "alias "
       * ty ", "
       * aliasee
       * @format:aliasee(ty * const)
       * ty " " const
       *)
      ALIAS of
      {
        name : symbol,
        ty : ty,
        linkage : linkage option,
        unnamed_addr : bool,
        aliasee : ty * const
      }
    | (*%
       * @format({name, ty}) 
       * name " = external global " ty
       *)
      EXTERN of
      {
        name : symbol,
        ty : ty
      }

  (*%
   * @formatter(string) formatString
   * @formatter(ifempty) ifempty
   * @formatter(ifsome) ifsome
   * @formatter(ifcons) ifcons
   *)
  type program =
      (*%
       * @format({moduleName,
       *          datalayout: layout layoutOpt,
       *          triple: triple tripleOpt,
       *          topdecs: dec decs})
       * moduleName:ifempty()(,"; ModuleID = " moduleName \n)
       * layoutOpt:ifsome()("target datalayout = ",)
       * layoutOpt(layout)
       * layoutOpt:ifsome()(\n,)
       * tripleOpt:ifsome()("target triple = ",)
       * tripleOpt(triple)
       * tripleOpt:ifsome()(\n,)
       * decs(dec)(\n)
       * decs:ifcons()(\n,)
       *)
      {moduleName : string,
       datalayout : string option,
       triple : string option,
       topdecs : topdec list}

end
